Develop and Download Open Source Software

Browse CVS Repository

Annotation of /gikonavigoeson/gikonavi/ExtPreviewDatamodule.pas

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.1 - (hide annotations) (download) (as text)
Mon Mar 3 14:51:02 2008 UTC (16 years, 1 month ago) by h677
Branch: MAIN
CVS Tags: v1_58_0_745
File MIME type: text/x-pascal
プレビューを他のアプリに渡す機能を追加

1 h677 1.1 unit ExtPreviewDatamodule;
2    
3     interface
4    
5     uses
6     SysUtils, Classes, bmRegExp, ExtCtrls;
7    
8     type
9     TCommand = class(TObject)
10     private
11     FCommand: String;
12     FConfirm: Boolean;
13     FContinue: Boolean;
14     FToURL: String;
15     public
16     constructor Create(const comm: String);
17     property Command: String read FCommand;
18     property Confirm: Boolean read FConfirm write FConfirm;
19     property Continue: Boolean read FContinue write FContinue;
20     property ToURL: String read FToURL write FToURL;
21     end;
22    
23     TExtPreviewDM = class(TDataModule)
24     ExecuteTimer: TTimer;
25     procedure DataModuleCreate(Sender: TObject);
26     procedure DataModuleDestroy(Sender: TObject);
27     procedure ExecuteTimerTimer(Sender: TObject);
28     private
29     { Private ?辿?転 }
30     FAWKStr: TAWKStr;
31     FRegs: TStringList;
32     FExecCommand: TCommand;
33     function ReadCommand(const Line: String): TCommand;
34     public
35     { Public ?辿?転 }
36     function PreviewURL(const URL: String): Boolean;
37     end;
38    
39     var
40     ExtPreviewDM: TExtPreviewDM;
41    
42     implementation
43    
44     uses
45     GikoSystem, IniFiles, GikoUtil, Windows;
46    
47     constructor TCommand.Create(const comm: String);
48     begin
49     FCommand := comm;
50     FConfirm := False;
51     FContinue := False;
52     FToURL := '';
53     end;
54     {$R *.dfm}
55     {
56     \brief ?R???X?g???N?^
57     }
58     procedure TExtPreviewDM.DataModuleCreate(Sender: TObject);
59     var
60     values: TStringList;
61     i, pos: Integer;
62     begin
63     FAWKStr := TAWKStr.Create(Self);
64     FRegs := TStringList.Create;
65     if (FileExists(GikoSys.GetExtpreviewFileName)) then begin
66     values := TStringList.Create;
67     try
68     values.LoadFromFile(GikoSys.GetExtpreviewFileName);
69     for i := 0 to values.Count - 1 do begin
70     if ( AnsiPos('#',values[i]) = 1 ) then begin
71     // ????#?長?n???辿???R?????g?s
72     end else begin
73     pos := AnsiPos(#9,values[i]);
74     if (pos > 0) then begin
75     FRegs.AddObject(
76     Copy(values[i], 1, pos - 1),
77     ReadCommand(
78     Copy(values[i], pos + 1, Length(values[i])))
79     );
80     end;
81     end;
82     end;
83     finally
84     values.Free;
85     end;
86     end;
87     end;
88     {
89     \brief ?f?X?g???N?^
90     }
91     procedure TExtPreviewDM.DataModuleDestroy(Sender: TObject);
92     begin
93     FRegs.Clear;
94     FRegs.Free;
95     FAWKStr.Free;
96     end;
97     {
98     \brief ?R?}???h?s????
99     }
100     function TExtPreviewDM.ReadCommand(const Line: String): TCommand;
101     var
102     pos: Integer;
103     sub: String;
104     begin
105    
106     // FCommand , FConfirm , FContinue ????
107     pos := AnsiPos(#9, Line);
108     if (pos > 0) then begin
109     Result := TCommand.Create( Copy(Line, 1, pos - 1) );
110     sub := Copy(Line, pos + 1, Length(Line));
111     end else begin
112     Result := TCommand.Create( '' );
113     sub := '';
114     end;
115     pos := AnsiPos(#9, sub);
116     if (pos > 0) then begin
117     if (AnsiLowerCase(Copy(sub, 1, pos - 1)) = 'true' ) then begin
118     Result.Confirm := True;
119     end;
120     sub := Copy(Line, pos + 1, Length(Line));
121     end;
122     sub := Trim(sub);
123     if (AnsiLowerCase(sub) = 'true' ) then begin
124     Result.Continue := True;
125     end;
126     end;
127     {
128     \brief ?o?^??????URL?????????辿?R?}???h??????
129     }
130     function TExtPreviewDM.PreviewURL(const URL: String): Boolean;
131     var
132     i: Integer;
133     RStart: Integer;
134     RLength: Integer;
135     EsqURL: String;
136     begin
137     Result := False;
138     ExecuteTimer.Interval := 0;
139     ExecuteTimer.Enabled := False;
140     FExecCommand := nil;
141     if (Length(URL) > 0) and (FRegs.Count > 0) then begin
142     EsqURL := FAWKStr.ProcessEscSeq(URL);
143     for i := 0 to FRegs.Count - 1 do begin
144     FAWKStr.RegExp := FRegs[i];
145     if ( FAWKStr.Match(EsqURL, RStart, RLength ) <> 0 ) then begin
146     FExecCommand := TCommand(FRegs.Objects[i]);
147     FExecCommand.ToURL := Copy(EsqURL, RStart, RLength);
148     ExecuteTimer.Interval := GikoSys.Setting.PreviewWait;
149     ExecuteTimer.Enabled := True;
150     Result := not FExecCommand.FContinue;
151     break;
152     end;
153     end;
154     end;
155     end;
156    
157     procedure TExtPreviewDM.ExecuteTimerTimer(Sender: TObject);
158     var
159     rc: Integer;
160     begin
161     // ?^?C?}?[?但?~
162     ExecuteTimer.Interval := 0;
163     ExecuteTimer.Enabled := False;
164    
165     if (FExecCommand <> nil) then begin
166     rc := ID_YES;
167     if (FExecCommand.Confirm) then begin
168     // Msg
169     rc := GikoUtil.MsgBox(0, FExecCommand.Command + '??'#13#10 +
170     FExecCommand.ToURL + ' ???n?直???????H',
171     '?m?F', MB_ICONQUESTION or MB_YESNO);
172     end;
173    
174     if (rc = ID_YES) then begin
175     GikoSys.CreateProcess(
176     FExecCommand.Command, '"' + FExecCommand.ToURL + '"');
177     end;
178     end;
179     end;
180    
181     end.

Back to OSDN">Back to OSDN
ViewVC Help
Powered by ViewVC 1.1.26