图片 2

delphi case 语句中使用字符串

非常遗憾 Delphi 的 case 语句不支持字符串,
但我觉得这也可能是基于效率的考量;
如果非要在 case 中使用字符串, 也不是不可以变通, 这里提供了五种方法.

图片 1

程序界面


源代码:

测试是在本机测试的,注意不能是127.0.0.1或者localhost,不然idhttp会罢工。由于测试论坛没有几篇文章,所以“下一页”,其实只读取了第一页。上一页还没做呢,呵。

本例效果图:


源代码:

图片 2

unit Unit1;

unit Unit1;

代码文件:

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,
Forms,
Dialogs, StdCtrls, ExtCtrls;

type
TForm1 = class(TForm)
RadioGroup1: TRadioGroup;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Button6: TButton;
procedure FormCreate(Sender: TObject,’,’,’);
procedure Button1Click(Sender: TObject,’,’,’);
procedure Button2Click(Sender: TObject,’,’,’);
procedure Button3Click(Sender: TObject,’,’,’);
procedure Button4Click(Sender: TObject,’,’,’);
procedure Button5Click(Sender: TObject,’,’,’);
procedure Button6Click(Sender: TObject,’,’,’);
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

uses TypInfo; {操作枚举用}

{初始化一个单选组, 用于测试}
procedure TForm1.FormCreate(Sender: TObject,’,’,’);
begin
RadioGroup1.Items.CommaText := ‘a,bb,ccc,dddd’;
RadioGroup1.ItemIndex := 0;
end;

{这是 case 语句比较常规的用法}
procedure TForm1.Button1Click(Sender: TObject,’,’,’);
begin
case RadioGroup1.ItemIndex of
0: Color := clRed;
1: Color := clYellow;
2: Color := clLime;
3: Color := clBlue;
end;
end;

{方法一: 假如要 case 的字符串的长度不同}
procedure TForm1.Button2Click(Sender: TObject,’,’,’);
var
str: string;
begin
str := RadioGroup1.Items[RadioGroup1.ItemIndex];
case Length(str) of
1 : Color := clRed;
2 : Color := clYellow;
3 : Color := clLime;
4 : Color := clBlue;
end;
end;

{方法二: 假如要 case 的字符串的第一个字母不同, case 是支持字符的}
procedure TForm1.Button3Click(Sender: TObject,’,’,’);
var
str: string;
begin
str := RadioGroup1.Items[RadioGroup1.ItemIndex];
case str[1] of
‘a’: Color := clRed;
‘b’: Color := clYellow;
‘c’: Color := clLime;
‘d’: Color := clBlue;
end;
end;

{方法三: 借用 TStringList}
procedure TForm1.Button4Click(Sender: TObject,’,’,’);
var
List: TStringList;
str: string;
begin
List := TStringList.Create;
List.Text := RadioGroup1.Items.Text;

str := RadioGroup1.Items[RadioGroup1.ItemIndex];
case List.IndexOf(str) of
0: Color := clRed;
1: Color := clYellow;
2: Color := clLime;
3: Color := clBlue;
end;

List.Free;
end;

{方法四: 借用枚举}
type
TMyEnum = (a, bb, ccc, dddd,’,’,’);

procedure TForm1.Button5Click(Sender: TObject,’,’,’);
var
MyEnum: TMyEnum;
str: String;
begin
str := RadioGroup1.Items[RadioGroup1.ItemIndex];

MyEnum := TMyEnum(GetEnumvalue(TypeInfo(TMyEnum), str),’,’,’);
case MyEnum of
a : Color := clRed;
bb : Color := clYellow;
ccc : Color := clLime;
dddd : Color := clBlue;
end;
end;

{方法五: 利用对比字符串返回的整数, 这种方法并不太可靠,
但在某种情况下会更灵活}
procedure TForm1.Button6Click(Sender: TObject,’,’,’);
var
str: string;
begin
str := RadioGroup1.Items[RadioGroup1.ItemIndex];
case CompareStr(str, ‘a’) of
0: Color := clRed;
1: Color := clYellow;
2: Color := clLime;
3: Color := clBlue;
end;
end;

end.

interface

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,
Forms,
  Dialogs, StdCtrls,StrUtils;

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,
Forms,
  Dialogs, ComCtrls, StdCtrls, IdBaseComponent, IdComponent,
IdTCPConnection,
  IdTCPClient, IdHTTP,perlregex,SHDocVw;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Label2: TLabel;
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
  *******
    { Private declarations }
  public
    { Public declarations }
  end;

type
    bbslist=record
    flName:string;
    flUrl:string;
end;

var
  Form1: TForm1;
  js:integer;
  keysum:integer;
  flage:Boolean;
  hThread1:THandle;
  function rndsum():integer;stdcall;
implementation

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Label1: TLabel;
    ListView1: TListView;
    Label2: TLabel;
    Edit1: TEdit;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    IdHTTP1: TIdHTTP;
    procedure FormShow(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ListView1DblClick(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
  *******
    { Private declarations }
  public
    { Public declarations }

{$R *.dfm}
//{$APPTYPE CONSOLE}

  end;

function rndsum():integer;stdcall;
var
  i: Integer;
  sum1: Integer;
  str1: string;
  str2: string;
begin
  sum1:=14;

var
  Form1: TForm1;
  bbsfl:array of bbslist;
  reg:tperlregex;
  userSelect:string;

  while True do
  begin
    if flage then
    begin
      flage:=false;
      Randomize;
      str1:=”;
      str2:=”;
      for i := 0 to sum1-1  do
      begin
        str1:=chr(48+Random(10));
        str2:=str2+str1;
      end;
      form1.Label1.Caption:=str2;
    end
    else
    begin
      sleep(10);
    end;

implementation

  end;
end;

{$R *.dfm}
{$APPTYPE CONSOLE}

procedure TForm1.Button1Click(Sender: TObject);
var
  id: DWORD;
begin
//产生随机数线程
flage:=true;
hThread1:=CreateThread(nil,0,@rndsum,nil,0,id);
if(hThread1=0) then
begin
  ShowMessage(‘线程创建失败!’);
  exit;
end;
//光标定位
form1.Edit1.SetFocus;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  url: string;
  idhttp1: TIdhttp;
  streamstr1: TStringStream;
  html: string;
  i: Integer;
  n: Integer;
begin
  //下一页
  //如果listbox没有选择则返回
  if(Length(userSelect)<2)then
    exit;

 

  streamstr1:=TStringStream.Create(”);
  idhttp1:=TIdHTTP.Create(nil);
  idhttp1.ConnectTimeout:=12000;
  idhttp1.ReadTimeout:=12000;

procedure TForm1.Button2Click(Sender: TObject);
var
  I: Integer;
begin
  halt;

  //按栏目取url
  for I := 0 to 19 do
    begin
      if(bbsfl[i].flName=userSelect) then
       
url:=trim(form1.Edit1.Text)+
bbsfl[i].flUrl;
    end;
  writeln(url);
  //exit;
  //url:=”;

end;

  idhttp1.Get(url,streamstr1);
  html:=streamstr1.DataString;
  //Writeln(html);
  //正则分析
  reg:=TPerlRegEx.Create(nil);
  reg.Subject:=html;
 
reg.RegEx:=’^<as|href=”([wd.?_=&]+)”>([^<^>]+)</a>’;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
var
  c1: string;
  oldstr: string;
begin
  //只能输入数字
  if not (key in [‘0’..’9′,#8]) then
  begin
    key := #0;
    exit;
  end;

  //清空litview
  n:=ListView1.Items.Count;
  for i := 0 to n – 1 do
    listview1.items.delete(0);
  i:=0;

  c1:=form1.Label1.Caption;
  inc(js);
  if(midstr(c1,js,1)<>key) then //按错了
  begin
    dec(js);
    beep;
    key:=#0;
    exit;
  end;
  inc(keysum);

  while reg.MatchAgain do
  begin
    //写入listview
    inc(i);

  if(js>=14) then
  begin
    js:=0;
    form1.Edit1.Text:=”;
    key:=#0;
    flage:=true;
    sleep(1);
  end;

  with listview1.items.add do
  begin
    //编号
    Caption:=inttostr(i);
    //标题
    SubItems.Add(reg.SubExpressions[2]);
    //点击
    SubItems.Add(‘0’);
    //地址
    SubItems.Add(trim(form1.Edit1.Text)+reg.SubExpressions[1]);
  end;

  form1.Label2.Caption:=’击键次数:’+inttostr(keysum);

    //Writeln(reg.SubExpressions[2]);
  end;

end;

  streamstr1.Free;
  idhttp1.Free;
  reg.Free;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
//初始化变量
js:=0;
keysum:=0;
flage:=false;
form1.Label1.Font.Name:=’Arial Black’;
form1.Label1.Font.Height:=52;
form1.Edit1.Font.Name:=’Arial Black’;
form1.Edit1.Font.Height:=52;

procedure TForm1.Button3Click(Sender: TObject);
begin
  //bbsfl=nil;
  halt;
end;

end;

procedure TForm1.Button4Click(Sender: TObject);
var
  idhttp1:TIdHTTP;
  streamHtml:TStringStream;
  htmlStr:string;
  s1: string;
  s2: string;
  i: Integer;

end.

begin
  //读论坛栏目列表
  idhttp1.ReadTimeout:=12000;
  idhttp1.ConnectTimeout:=12000;
  //idhttp1.Request.UserAgent:=’Mozilla/4.0 (compatible; MSIE 6.0;
Windows NT 5.0; .NET CLR 1.1.4322)’;


  idhttp1:=TIdHTTP.Create(nil);
  streamHtml:=TStringStream.Create(”,TEncoding.GetEncoding(936));

界面代码:

  try
    idhttp1.Get(trim(form1.Edit1.Text),streamHtml);
    htmlStr:=streamHtml.DataString;
    //writeln(htmlStr);
    //正则分析
    reg:=tperlregex.Create(nil);
    reg.Subject:=htmlStr;
   
reg.RegEx:='<as+href=”([w.?_=d]+)”><fonts+color=#[wd]+><b>(.+)</b>’;
    //设置动态数组bbsfl

object Form1: TForm1
  Left = 0
  Top = 0
  BorderIcons = [biSystemMenu, biMinimize]
  Caption = #23567#38190#30424#32451#20064′ 
‘#29482#24735#33021
  ClientHeight = 252
  ClientWidth = 390
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = ‘Tahoma’
  Font.Style = []
  OldCreateOrder = False
  OnShow = FormShow
  PixelsPerInch = 96
  TextHeight = 13
  object Label2: TLabel
    Left = 24
    Top = 8
    Width = 3
    Height = 13
  end
  object Label1: TLabel
    Left = 24
    Top = 49
    Width = 8
    Height = 29
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clRed
    Font.Height = -24
    Font.Name = ‘Tahoma’
    Font.Style = []
    ParentFont = False
  end
  object Edit1: TEdit
    Left = 24
    Top = 120
    Width = 353
    Height = 41
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clBlue
    Font.Height = -19
    Font.Name = ‘Tahoma’
    Font.Style = []
    ParentFont = False
    TabOrder = 0
    OnKeyPress = Edit1KeyPress
  end
  object Button1: TButton
    Left = 208
    Top = 203
    Width = 81
    Height = 30
    Caption = #24320#22987
    TabOrder = 1
    OnClick = Button1Click
  end
  object Button2: TButton
    Left = 295
    Top = 203
    Width = 82
    Height = 30
    Caption = #36864#20986
    TabOrder = 2
    OnClick = Button2Click
  end
end
 

    SetLength(bbsfl,20);

源代码下载:

    i:=0;
    while reg.MatchAgain do
    begin
       s1:=reg.SubExpressions[1];
       s2:=reg.SubExpressions[2];
       //writeln(reg.SubExpressions[0]);
       bbsfl[i].flName:=s2;
       bbsfl[i].flUrl:=s1;
       form1.ListBox1.Items.Add(s2);
       inc(i);
    end;

  except
    on e:Exception do
    begin
      ShowMessage(e.Message);
    end;
  end;
  streamHtml.Free;

end;

procedure TForm1.FormShow(Sender: TObject);
begin
  ListView1.Clear;
  ListView1.Columns.Clear;
  ListView1.Columns.Add;
  ListView1.Columns.Add;
  ListView1.Columns.Add;
  ListView1.Columns.Add;
  ListView1.Columns.Items[0].Caption:=’编号’;
  ListView1.Columns.Items[1].Caption:=’主题’;
  ListView1.Columns.Items[2].Caption:=’点击/回复’;
  ListView1.Columns.Items[3].Caption:=’地址’;
  ListView1.Columns.Items[0].Width:=40;
  ListView1.Columns.Items[1].Width:=210;
  ListView1.Columns.Items[2].Width:=80;
  ListView1.Columns.Items[3].Width:=120;
  Listview1.ViewStyle:=vsreport;
  Listview1.GridLines:=true;

  edit1.Text:=”;
end;

procedure TForm1.ListBox1Click(Sender: TObject);
begin
if   ListBox1.Selected[ListBox1.ItemIndex]   then
      userSelect:=ListBox1.Items[ListBox1.ItemIndex];
end;

procedure TForm1.ListView1DblClick(Sender: TObject);
var
  url: string;
  ie:OleVariant;
begin
  //双击阅读贴子
  //writeln(ListView1.Selected.SubItems.Strings[0]);
 
[url:=ListView1.Selected.SubItems.Strings[2](];
  ie:=CoInternetExplorer.Create;
  ie.Visible := True;
  ie.Navigate2(url);

end;

end.

界面代码:


object Form1: TForm1
  Left = 0
  Top = 0
  BorderIcons = [biSystemMenu, biMinimize]
  Caption = #32654#20029#20154#29983#35770#22363#35835#36148′ 
‘#29482#24735#33021
  ClientHeight = 299
  ClientWidth = 346
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = ‘Tahoma’
  Font.Style = []
  OldCreateOrder = False
  OnShow = FormShow
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 8
    Top = 36
    Width = 36
    Height = 13
    Caption = #36873#29256#65306
  end
  object Label2: TLabel
    Left = 9
    Top = 9
    Width = 23
    Height = 13
    Caption = ‘URL:’
  end
  object ListBox1: TListBox
    Left = 42
    Top = 36
    Width = 224
    Height = 46
    ItemHeight = 13
    TabOrder = 0
    OnClick = ListBox1Click
  end
  object ListView1: TListView
    Left = 8
    Top = 88
    Width = 329
    Height = 169
    Columns = <>
    FlatScrollBars = True
    GridLines = True
    HideSelection = False
    RowSelect = True
    TabOrder = 1
    OnDblClick = ListView1DblClick
  end
  object Edit1: TEdit
    Left = 42
    Top = 9
    Width = 224
    Height = 21
    TabOrder = 2
  end
  object Button1: TButton
    Left = 202
    Top = 263
    Width = 65
    Height = 28
    Caption = #19979#19968#39029
    TabOrder = 3
    OnClick = Button1Click
  end
  object Button2: TButton
    Left = 131
    Top = 263
    Width = 65
    Height = 28
    Caption = #19978#19968#39029
    TabOrder = 4
  end
  object Button3: TButton
    Left = 273
    Top = 263
    Width = 65
    Height = 28
    Caption = #36864#20986
    TabOrder = 5
    OnClick = Button3Click
  end
  object Button4: TButton
    Left = 273
    Top = 8
    Width = 49
    Height = 21
    Caption = ‘GO’
    TabOrder = 6
    OnClick = Button4Click
  end
  object IdHTTP1: TIdHTTP
    AllowCookies = True
    ProxyParams.BasicAuthentication = False
    ProxyParams.ProxyPort = 0
    Request.ContentLength = -1
    Request.Accept = ‘text/html, */*’
    Request.BasicAuthentication = False
    Request.UserAgent = ‘Mozilla/3.0 (compatible; Indy Library)’
    HTTPOptions = [hoForceEncodeParams]
    Left = 8
    Top = 256
  end
end
 

源代码下载:

发表评论

电子邮件地址不会被公开。 必填项已用*标注